home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / lib / mathlib / libblas / src_original / cgemv.f < prev    next >
Encoding:
Text File  |  1994-08-02  |  8.1 KB  |  285 lines
  1. *
  2. ************************************************************************
  3. *
  4.       SUBROUTINE CGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
  5.      $                   BETA, Y, INCY )
  6. *     .. Scalar Arguments ..
  7.       COMPLEX            ALPHA, BETA
  8.       INTEGER            INCX, INCY, LDA, M, N
  9.       CHARACTER*1        TRANS
  10. *     .. Array Arguments ..
  11.       COMPLEX            A( LDA, * ), X( * ), Y( * )
  12. *     ..
  13. *
  14. *  Purpose
  15. *  =======
  16. *
  17. *  CGEMV  performs one of the matrix-vector operations
  18. *
  19. *     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   or
  20. *
  21. *     y := alpha*conjg( A' )*x + beta*y,
  22. *
  23. *  where alpha and beta are scalars, x and y are vectors and A is an
  24. *  m by n matrix.
  25. *
  26. *  Parameters
  27. *  ==========
  28. *
  29. *  TRANS  - CHARACTER*1.
  30. *           On entry, TRANS specifies the operation to be performed as
  31. *           follows:
  32. *
  33. *              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
  34. *
  35. *              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
  36. *
  37. *              TRANS = 'C' or 'c'   y := alpha*conjg( A' )*x + beta*y.
  38. *
  39. *           Unchanged on exit.
  40. *
  41. *  M      - INTEGER.
  42. *           On entry, M specifies the number of rows of the matrix A.
  43. *           M must be at least zero.
  44. *           Unchanged on exit.
  45. *
  46. *  N      - INTEGER.
  47. *           On entry, N specifies the number of columns of the matrix A.
  48. *           N must be at least zero.
  49. *           Unchanged on exit.
  50. *
  51. *  ALPHA  - COMPLEX         .
  52. *           On entry, ALPHA specifies the scalar alpha.
  53. *           Unchanged on exit.
  54. *
  55. *  A      - COMPLEX          array of DIMENSION ( LDA, n ).
  56. *           Before entry, the leading m by n part of the array A must
  57. *           contain the matrix of coefficients.
  58. *           Unchanged on exit.
  59. *
  60. *  LDA    - INTEGER.
  61. *           On entry, LDA specifies the first dimension of A as declared
  62. *           in the calling (sub) program. LDA must be at least
  63. *           max( 1, m ).
  64. *           Unchanged on exit.
  65. *
  66. *  X      - COMPLEX          array of DIMENSION at least
  67. *           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
  68. *           and at least
  69. *           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
  70. *           Before entry, the incremented array X must contain the
  71. *           vector x.
  72. *           Unchanged on exit.
  73. *
  74. *  INCX   - INTEGER.
  75. *           On entry, INCX specifies the increment for the elements of
  76. *           X. INCX must not be zero.
  77. *           Unchanged on exit.
  78. *
  79. *  BETA   - COMPLEX         .
  80. *           On entry, BETA specifies the scalar beta. When BETA is
  81. *           supplied as zero then Y need not be set on input.
  82. *           Unchanged on exit.
  83. *
  84. *  Y      - COMPLEX          array of DIMENSION at least
  85. *           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
  86. *           and at least
  87. *           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
  88. *           Before entry with BETA non-zero, the incremented array Y
  89. *           must contain the vector y. On exit, Y is overwritten by the
  90. *           updated vector y.
  91. *
  92. *  INCY   - INTEGER.
  93. *           On entry, INCY specifies the increment for the elements of
  94. *           Y. INCY must not be zero.
  95. *           Unchanged on exit.
  96. *
  97. *
  98. *  Level 2 Blas routine.
  99. *
  100. *  -- Written on 22-October-1986.
  101. *     Jack Dongarra, Argonne National Lab.
  102. *     Jeremy Du Croz, Nag Central Office.
  103. *     Sven Hammarling, Nag Central Office.
  104. *     Richard Hanson, Sandia National Labs.
  105. *
  106. *
  107. *     .. Parameters ..
  108.       COMPLEX            ONE
  109.       PARAMETER        ( ONE  = ( 1.0E+0, 0.0E+0 ) )
  110.       COMPLEX            ZERO
  111.       PARAMETER        ( ZERO = ( 0.0E+0, 0.0E+0 ) )
  112. *     .. Local Scalars ..
  113.       COMPLEX            TEMP
  114.       INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
  115.       LOGICAL            NOCONJ
  116. *     .. External Functions ..
  117.       LOGICAL            LSAME
  118.       EXTERNAL           LSAME
  119. *     .. External Subroutines ..
  120.       EXTERNAL           XERBLA
  121. *     .. Intrinsic Functions ..
  122.       INTRINSIC          CONJG, MAX
  123. *     ..
  124. *     .. Executable Statements ..
  125. *
  126. *     Test the input parameters.
  127. *
  128.       INFO = 0
  129.       IF     ( .NOT.LSAME( TRANS, 'N' ).AND.
  130.      $         .NOT.LSAME( TRANS, 'T' ).AND.
  131.      $         .NOT.LSAME( TRANS, 'C' )      )THEN
  132.          INFO = 1
  133.       ELSE IF( M.LT.0 )THEN
  134.          INFO = 2
  135.       ELSE IF( N.LT.0 )THEN
  136.          INFO = 3
  137.       ELSE IF( LDA.LT.MAX( 1, M ) )THEN
  138.          INFO = 6
  139.       ELSE IF( INCX.EQ.0 )THEN
  140.          INFO = 8
  141.       ELSE IF( INCY.EQ.0 )THEN
  142.          INFO = 11
  143.       END IF
  144.       IF( INFO.NE.0 )THEN
  145.          CALL XERBLA( 'CGEMV ', INFO )
  146.          RETURN
  147.       END IF
  148. *
  149. *     Quick return if possible.
  150. *
  151.       IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
  152.      $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
  153.      $   RETURN
  154. *
  155.       NOCONJ = LSAME( TRANS, 'T' )
  156. *
  157. *     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
  158. *     up the start points in  X  and  Y.
  159. *
  160.       IF( LSAME( TRANS, 'N' ) )THEN
  161.          LENX = N
  162.          LENY = M
  163.       ELSE
  164.          LENX = M
  165.          LENY = N
  166.       END IF
  167.       IF( INCX.GT.0 )THEN
  168.          KX = 1
  169.       ELSE
  170.          KX = 1 - ( LENX - 1 )*INCX
  171.       END IF
  172.       IF( INCY.GT.0 )THEN
  173.          KY = 1
  174.       ELSE
  175.          KY = 1 - ( LENY - 1 )*INCY
  176.       END IF
  177. *
  178. *     Start the operations. In this version the elements of A are
  179. *     accessed sequentially with one pass through A.
  180. *
  181. *     First form  y := beta*y.
  182. *
  183.       IF( BETA.NE.ONE )THEN
  184.          IF( INCY.EQ.1 )THEN
  185.             IF( BETA.EQ.ZERO )THEN
  186.                DO 10, I = 1, LENY
  187.                   Y( I ) = ZERO
  188.    10          CONTINUE
  189.             ELSE
  190.                DO 20, I = 1, LENY
  191.                   Y( I ) = BETA*Y( I )
  192.    20          CONTINUE
  193.             END IF
  194.          ELSE
  195.             IY = KY
  196.             IF( BETA.EQ.ZERO )THEN
  197.                DO 30, I = 1, LENY
  198.                   Y( IY ) = ZERO
  199.                   IY      = IY   + INCY
  200.    30          CONTINUE
  201.             ELSE
  202.                DO 40, I = 1, LENY
  203.                   Y( IY ) = BETA*Y( IY )
  204.                   IY      = IY           + INCY
  205.    40          CONTINUE
  206.             END IF
  207.          END IF
  208.       END IF
  209.       IF( ALPHA.EQ.ZERO )
  210.      $   RETURN
  211.       IF( LSAME( TRANS, 'N' ) )THEN
  212. *
  213. *        Form  y := alpha*A*x + y.
  214. *
  215.          JX = KX
  216.          IF( INCY.EQ.1 )THEN
  217.             DO 60, J = 1, N
  218.                IF( X( JX ).NE.ZERO )THEN
  219.                   TEMP = ALPHA*X( JX )
  220.                   DO 50, I = 1, M
  221.                      Y( I ) = Y( I ) + TEMP*A( I, J )
  222.    50             CONTINUE
  223.                END IF
  224.                JX = JX + INCX
  225.    60       CONTINUE
  226.          ELSE
  227.             DO 80, J = 1, N
  228.                IF( X( JX ).NE.ZERO )THEN
  229.                   TEMP = ALPHA*X( JX )
  230.                   IY   = KY
  231.                   DO 70, I = 1, M
  232.                      Y( IY ) = Y( IY ) + TEMP*A( I, J )
  233.                      IY      = IY      + INCY
  234.    70             CONTINUE
  235.                END IF
  236.                JX = JX + INCX
  237.    80       CONTINUE
  238.          END IF
  239.       ELSE
  240. *
  241. *        Form  y := alpha*A'*x + y  or  y := alpha*conjg( A' )*x + y.
  242. *
  243.          JY = KY
  244.          IF( INCX.EQ.1 )THEN
  245.             DO 110, J = 1, N
  246.                TEMP = ZERO
  247.                IF( NOCONJ )THEN
  248.                   DO 90, I = 1, M
  249.                      TEMP = TEMP + A( I, J )*X( I )
  250.    90             CONTINUE
  251.                ELSE
  252.                   DO 100, I = 1, M
  253.                      TEMP = TEMP + CONJG( A( I, J ) )*X( I )
  254.   100             CONTINUE
  255.                END IF
  256.                Y( JY ) = Y( JY ) + ALPHA*TEMP
  257.                JY      = JY      + INCY
  258.   110       CONTINUE
  259.          ELSE
  260.             DO 140, J = 1, N
  261.                TEMP = ZERO
  262.                IX   = KX
  263.                IF( NOCONJ )THEN
  264.                   DO 120, I = 1, M
  265.                      TEMP = TEMP + A( I, J )*X( IX )
  266.                      IX   = IX   + INCX
  267.   120             CONTINUE
  268.                ELSE
  269.                   DO 130, I = 1, M
  270.                      TEMP = TEMP + CONJG( A( I, J ) )*X( IX )
  271.                      IX   = IX   + INCX
  272.   130             CONTINUE
  273.                END IF
  274.                Y( JY ) = Y( JY ) + ALPHA*TEMP
  275.                JY      = JY      + INCY
  276.   140       CONTINUE
  277.          END IF
  278.       END IF
  279. *
  280.       RETURN
  281. *
  282. *     End of CGEMV .
  283. *
  284.       END
  285.